
package Sgdb::SourceSyntaxJ ;


#  This is a 'stupid' one function module. It was
#  separated from the Sgdb::SourcePane module for
#  the sake of portability.

use warnings ;
use strict ;
use integer ;
use bytes ;

# Perlon: I've tried putting the different expressions in variables, and
# use them with the m/../o switch, but it seems to run faster this way.

my  $parse = qr{\G              # end of prev match
               (.*?)            # 1. whatever
               (                # 2. match first of:
                                # 3. comment
               ( /\*\*/ |
                 /\*.*?[^\\]\*/ |
                 //.*?\n
                 )
                                |
                                # 4. quote
                ( \"\"            |
                  \" .*? (?:[^\\] |
                          \\ \\
                          ) \"    |
                  \' \\ \\ \'     |
                  \'.\'
                  )
                                |
#                                 # 5. compiler instructs
# # Javalon: this one should never happen ..
#                 ( (?<=\n) \# .*? [^\\]\n
#                   )
#                                 |
                                # 6. known types

# Perlon: known types and key words are 'unnecessarily short circuit'.
# one way to make this rexp run faster is by optimizing the conditions
# to things like (?:un)?signed, si(?:zeof|gned) or better:
# s (:? hort | izeof | tatic | witch ).

                ( \b (?:
# Perlon: another way to optimize is to skip this expression unless word
# starts with one of those letters

# Javalon: very few types
                         (?=[bcsilfd])
                         boolean | byte | char |
                         short   | int  | long |
                         double  | float

                      ) \b
                  )
                                |
                                # 7. key words
                ( \b (:?
                         a (?: ssert| bstract) |
                         break      |
                         c (?: lass | a (?: se | tch ) | on (?: st | tinue ) ) |
                         d (?: do   | efault ) |
                         e (?: lse  | xtends ) |
                         f (?: alse | inal (:? | ly)   | or ) |
                         goto       |
                         i (?: f    | mp   (?: lements | ort) | n (?: stanceof | terface) ) |
                         n (?: ew   | ative    | ull ) |
                         p (?: ublic| r    (?: ivate   | otected ) ) |
                         return     |
                         s (?: t (?: atic  | rictfp )  | uper | witch | ynchonized ) |
                         t (?: h (?: row   | is| rows) | true | r (?:y| ansient) )   |
                         vo(?: id | latile)|
                         while
                      ) \b
                  )
                                |

                                # 8. end of file
                (\z)
                )
               }xs ;

sub parse {

    my $file = shift or die "arg" ;

    unless (open FILE, $file) {

        return ["can't open the file $file: $!\n"] ;
    }

                                # speed, speed and speed

    $file = join '', <FILE> ;
    close FILE ;

    study $file ;
    $file =~ y/\r//d ;
    my @file ;

    while ($file =~ /$parse/go ) {

        push @file, ( $1,      'face-code',
                      $2, qw ( face-comments
                               face-quotations

                               face-knowntypes
                               face-keywords
                               face-code
                              ) [$3 ? 0 :
                                 $4 ? 1 :
                                 $5 ? 2 :
                                 $6 ? 3 :
                                      4 ]
 # Perlon: this is a C like 'if else if' chain. I wonder
 # if Perl's 'if elsif' chain would yield more optimized
 # byte code.
                      ) ;
    }
    \@file ;
}

'end'
